# llegim les dades en format text (“.sav”) de SPSS
library(haven)
library(tidyverse)
## ── Attaching packages ────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.1.0     ✔ purrr   0.2.5
## ✔ tibble  2.0.1     ✔ dplyr   0.7.8
## ✔ tidyr   0.8.2     ✔ stringr 1.3.1
## ✔ readr   1.3.1     ✔ forcats 0.3.0
## ── Conflicts ───────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
setwd("~/Desktop/R - BData/GemmaRenart - ACP 1")
dades <- read_sav("Data/Posicionament.sav")
dades.sel <- dades[,10:26] #No prenem la variable val_global perquè sobreentenem que recull informació de cadascuna 
summary(dades.sel)
##     val_play        val_ento        val_tran        val_urba    
##  Min.   :1.000   Min.   :2.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:5.000   1st Qu.:5.000   1st Qu.:3.000   1st Qu.:4.000  
##  Median :6.000   Median :6.000   Median :5.000   Median :5.000  
##  Mean   :5.725   Mean   :5.895   Mean   :4.567   Mean   :5.018  
##  3rd Qu.:7.000   3rd Qu.:7.000   3rd Qu.:6.000   3rd Qu.:6.000  
##  Max.   :7.000   Max.   :7.000   Max.   :7.000   Max.   :7.000  
##     val_tiem        val_segu        val_inor        val_inal    
##  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:6.000   1st Qu.:5.000   1st Qu.:5.000   1st Qu.:5.000  
##  Median :6.000   Median :5.000   Median :5.000   Median :6.000  
##  Mean   :6.017   Mean   :5.161   Mean   :5.422   Mean   :5.488  
##  3rd Qu.:7.000   3rd Qu.:6.000   3rd Qu.:6.000   3rd Qu.:6.000  
##  Max.   :7.000   Max.   :7.000   Max.   :7.000   Max.   :7.000  
##     val_inof        val_vacu        val_valu        val_vade    
##  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:5.000   1st Qu.:5.000   1st Qu.:5.000   1st Qu.:4.000  
##  Median :6.000   Median :5.000   Median :6.000   Median :5.000  
##  Mean   :5.597   Mean   :5.195   Mean   :5.614   Mean   :5.014  
##  3rd Qu.:6.000   3rd Qu.:6.000   3rd Qu.:7.000   3rd Qu.:6.000  
##  Max.   :7.000   Max.   :7.000   Max.   :7.000   Max.   :7.000  
##     val_vare        val_rere       val_reti       val_real    
##  Min.   :1.000   Min.   :1.00   Min.   :1.00   Min.   :1.000  
##  1st Qu.:5.000   1st Qu.:4.00   1st Qu.:4.00   1st Qu.:4.000  
##  Median :6.000   Median :5.00   Median :5.00   Median :5.000  
##  Mean   :5.591   Mean   :4.93   Mean   :4.81   Mean   :5.019  
##  3rd Qu.:6.000   3rd Qu.:6.00   3rd Qu.:6.00   3rd Qu.:6.000  
##  Max.   :7.000   Max.   :7.00   Max.   :7.00   Max.   :7.000  
##     val_amab    
##  Min.   :1.000  
##  1st Qu.:5.000  
##  Median :6.000  
##  Mean   :5.714  
##  3rd Qu.:7.000  
##  Max.   :7.000
library(lattice)
splom(dades.sel , cex=0.1)

splom( ~dades.sel[,1:6],  pscale=0, alpha=0.2, cex=0.5, pch=20) 

# install.packages("corrplot")
library(corrplot)
## corrplot 0.84 loaded
p.mat <- cor(dades.sel)
corrplot(cor(dades.sel), method = "color",
         type = "upper", order = "hclust", number.cex = .5,
         addCoef.col = "black", # Add coefficient of correlation
         tl.col = "black", tl.srt = 90, # Text label color and rotation
         # Combine with significance
         p.mat = p.mat, sig.level = 0.1, insig = "label_sig", 
         # hide correlation coefficient on the principal diagonal
         diag = FALSE)

Anàlisi de components

Les components s’obtenen com a combinacions lineals de les variables originals, concepte semblant al de mitjana ponderada, amb l’objectiu d’explicar la màxima variància possible de les variables originals.

Se seleccionen de la manera següent: S’extreu una primera component de manera que reculli la màxima variància del conjunt de les variables originals. S’extreu una segona component, de manera que no estigui correlacionada amb la primera, i que extregui la màxima variància que resta al conjunt de dades originals. D’aquesta manera, les diferents components ja no seran redundants entre elles. *Continuem així fins arribar a l’extracció total de la variància de les variables originals.

Criteris estadístics:

  1. Un primer criteri és quedar-se amb el nombre de dimensions que aconsegueixin explicar un percentatge suficient de la variància total del conjunt. En funció de l’estudi la paraula suficient és un concepte relatiu i s’ha vist de tot, entre el 60% i el 80%
acp <-prcomp(dades.sel,center=T,scale.=T)
#Recordem que el sumatori de variancies ha de ser igual al número de variables, p = 18

print(acp$sdev^2)
##  [1] 5.5411089 1.5822168 1.2712134 1.0733528 0.9404629 0.8221782 0.7324637
##  [8] 0.6433289 0.6174939 0.6011664 0.5754384 0.5302212 0.5097981 0.4779473
## [15] 0.4506381 0.3432924 0.2876785
summary(acp)
## Importance of components:
##                          PC1     PC2     PC3     PC4     PC5     PC6
## Standard deviation     2.354 1.25786 1.12748 1.03603 0.96977 0.90674
## Proportion of Variance 0.326 0.09307 0.07478 0.06314 0.05532 0.04836
## Cumulative Proportion  0.326 0.41902 0.49380 0.55693 0.61226 0.66062
##                            PC7     PC8     PC9    PC10    PC11    PC12
## Standard deviation     0.85584 0.80208 0.78581 0.77535 0.75858 0.72816
## Proportion of Variance 0.04309 0.03784 0.03632 0.03536 0.03385 0.03119
## Cumulative Proportion  0.70371 0.74155 0.77787 0.81323 0.84708 0.87827
##                           PC13    PC14    PC15    PC16    PC17
## Standard deviation     0.71400 0.69134 0.67130 0.58591 0.53636
## Proportion of Variance 0.02999 0.02811 0.02651 0.02019 0.01692
## Cumulative Proportion  0.90826 0.93638 0.96288 0.98308 1.00000

Observem que les 5 primeres variables representen un 60.805% de la variància total p=18

  1. Un segon criteri és quedar-se amb els valors propis (lambdak) superiors a 1, (Criteri de Kaiser)
print(acp$sdev^2)
##  [1] 5.5411089 1.5822168 1.2712134 1.0733528 0.9404629 0.8221782 0.7324637
##  [8] 0.6433289 0.6174939 0.6011664 0.5754384 0.5302212 0.5097981 0.4779473
## [15] 0.4506381 0.3432924 0.2876785
plot(acp$sdev^2, type='h', col=ifelse(acp$sdev^2 > 1 ,"red", "grey"), lwd = 12)
abline(h=1, col="green", lwd = 4)

Aquest criteri ens faria destacar les 4 primeres variables, que expliquen el 55,562% de les variables…

  1. Un altre criteri és el diagrama de sedimentació, que representa les variàncies explicades ordenades de més a menys, i fa fàcil separar el gra de la palla tot observant quan la variància explicada fa una estrebada cap amunt.
plot(acp, type='l')

segons aquest criteri, agafaríem sols la 1a variabale, que no és suficient ja que només explica aprox. un 30% de les variables.

Com que la solució no està molt clara, prendrem el 1r criteri el qual la interpretació amb 4 components…

cor(dades.sel,acp$x[,1:4])
##                 PC1           PC2          PC3          PC4
## val_play -0.5027829  0.4520666149 -0.145355022  0.051932797
## val_ento -0.5628075  0.3357973473  0.038648181  0.082929082
## val_tran -0.5727752  0.3083218673 -0.050984680  0.270026595
## val_urba -0.5440965  0.2702819573 -0.008983050  0.478291396
## val_tiem -0.4009045  0.2261732058 -0.117106051  0.137969217
## val_segu -0.5274726  0.1814803175 -0.001641926  0.301373482
## val_inor -0.6338702  0.0899025208 -0.205121773 -0.413908737
## val_inal -0.6686428  0.0398825597 -0.279003989 -0.474349933
## val_inof -0.7038970  0.1358448882 -0.097920597 -0.293166428
## val_vacu -0.6278123 -0.0587189396  0.294357345 -0.167061572
## val_valu -0.3670303 -0.0004613094  0.668436794 -0.180469984
## val_vade -0.5580057 -0.1311099225  0.485271906 -0.007808646
## val_vare -0.5793493 -0.2666263159  0.401668150  0.060649286
## val_rere -0.5310222 -0.6527141730 -0.147992219  0.219248421
## val_reti -0.5798596 -0.5652348650 -0.196931646  0.231037690
## val_real -0.6304271 -0.3686278018 -0.333698331 -0.062021679
## val_amab -0.6104266  0.1078028502 -0.019232545  0.021258001
# Guardem en un objecte, que anomenarem C, la matriu de correlacions de cada variable amb les dues primeres components
# (saturacions):
C <- cor(dades.sel,acp$x)[ , 1:4 ]
# Obtenim les comunalitats amb el següent càlcul:
rowSums(C*C)
##  val_play  val_ento  val_tran  val_urba  val_tiem  val_segu  val_inor 
## 0.4809799 0.4378830 0.4986476 0.5979367 0.2446281 0.4019912 0.6232693 
##  val_inal  val_inof  val_vacu  val_valu  val_vade  val_vare  val_rere 
## 0.7515249 0.6094599 0.5121520 0.6140886 0.5641099 0.5717508 0.7779920 
##  val_reti  val_real  val_amab 
## 0.7478881 0.6485260 0.3850638

La variable ‘val_tiem’ és la que menor percentatge de variància explicada té (24.46%). La variable ‘val_rere’ és la que major percentatge de variància explicada té (77.77%).

plot(C[,1],C[,2],xlim=c(-1,1),ylim=c(-1,1),xlab="primera component",ylab="segona component")
text(x=C[,1],y=C[,2],labels=row.names(C),pos=4,cex=0.5)
title(main="Gràfic de Components")
abline(h=0, v=0, col = "gray60")

plot(C[,2],C[,4],xlim=c(-1,1),ylim=c(-1,1),xlab="tercera component",ylab="quarta component")
text(x=C[,2],y=C[,4],labels=row.names(C),pos=4,cex=0.5)
title(main="Gràfic de Components")
abline(h=0, v=0, col = "gray60")

rotats <- varimax(C)
rotats
## $loadings
## 
## Loadings:
##          PC1    PC2    PC3    PC4   
## val_play -0.600               -0.338
## val_ento -0.566         0.218 -0.264
## val_tran -0.670 -0.101  0.122 -0.157
## val_urba -0.743 -0.171  0.123       
## val_tiem -0.455               -0.180
## val_segu -0.583 -0.177  0.160       
## val_inor -0.213 -0.133  0.143 -0.734
## val_inal -0.179 -0.191  0.110 -0.819
## val_inof -0.337 -0.132  0.244 -0.647
## val_vacu -0.210 -0.175  0.565 -0.344
## val_valu                0.771       
## val_vade -0.196 -0.195  0.690 -0.108
## val_vare -0.178 -0.358  0.637       
## val_rere        -0.858  0.170       
## val_reti -0.164 -0.828  0.134 -0.132
## val_real -0.157 -0.644        -0.455
## val_amab -0.434 -0.189  0.231 -0.328
## 
##                  PC1   PC2   PC3   PC4
## SS loadings    2.780 2.233 2.094 2.360
## Proportion Var 0.164 0.131 0.123 0.139
## Cumulative Var 0.164 0.295 0.418 0.557
## 
## $rotmat
##            [,1]       [,2]       [,3]       [,4]
## [1,]  0.5862411  0.4289260 -0.4382240  0.5294370
## [2,] -0.5766834  0.7927557 -0.1502493 -0.1280621
## [3,]  0.1045826  0.3008221  0.8749621  0.3647051
## [4,] -0.5593032 -0.3115559 -0.1408053  0.7551733
names(rotats)
## [1] "loadings" "rotmat"
rotats$loadings
## 
## Loadings:
##          PC1    PC2    PC3    PC4   
## val_play -0.600               -0.338
## val_ento -0.566         0.218 -0.264
## val_tran -0.670 -0.101  0.122 -0.157
## val_urba -0.743 -0.171  0.123       
## val_tiem -0.455               -0.180
## val_segu -0.583 -0.177  0.160       
## val_inor -0.213 -0.133  0.143 -0.734
## val_inal -0.179 -0.191  0.110 -0.819
## val_inof -0.337 -0.132  0.244 -0.647
## val_vacu -0.210 -0.175  0.565 -0.344
## val_valu                0.771       
## val_vade -0.196 -0.195  0.690 -0.108
## val_vare -0.178 -0.358  0.637       
## val_rere        -0.858  0.170       
## val_reti -0.164 -0.828  0.134 -0.132
## val_real -0.157 -0.644        -0.455
## val_amab -0.434 -0.189  0.231 -0.328
## 
##                  PC1   PC2   PC3   PC4
## SS loadings    2.780 2.233 2.094 2.360
## Proportion Var 0.164 0.131 0.123 0.139
## Cumulative Var 0.164 0.295 0.418 0.557

PC1 Entorn

val_play -val_ento val_tran val_urba -val_segu -val_amab -val_tiem

PC2 Informació

val_rere val_reti val_real

PC3 Oferta

val_valu val_vale val_vare -val_vacu

PC4 Informació

val_inor val_inal val_inof

plot(rotats$loadings[,1],rotats$loadings[,2],xlim=c(-1,1),ylim=c(-1,1),xlab="primera component",ylab="segona component")
text(x=rotats$loadings[,1],y=rotats$loadings[,2],labels=row.names(C),pos=4,cex=0.5)
title(main="Grafic de Components Rotades")
abline(h=0, v=0, col = "gray60")

plot(rotats$loadings[,3],rotats$loadings[,4],xlim=c(-1,1),ylim=c(-1,1),xlab="tercera component",ylab="quarta component")
text(x=rotats$loadings[,3],y=rotats$loadings[,4],labels=row.names(C),pos=4,cex=0.5)
title(main="Grafic de Components Rotades")
abline(h=0, v=0, col = "gray60")

plot(acp$x[,1],acp$x[,2],xlab='primera component',ylab='segona component')
text(x=acp$x[,1],y=acp$x[,2],labels=row.names(dades.sel),pos=4,cex=0.5)
abline(h=0,v=0,col="gray60")

plot(acp$x[,3],acp$x[,4],xlab='tercera component',ylab='quarta component')
text(x=acp$x[,3],y=acp$x[,4],labels=row.names(dades.sel),pos=4,cex=0.5)
abline(h=0,v=0,col="gray60")

biplot(acp$x[,1:2],C,cex=0.5)
abline(h=0,v=0,col="gray60")

biplot(acp$x[,3:4],C,cex=0.5)
abline(h=0,v=0,col="gray60")

Interpretació amb variables il·lustratives.

Les variables il·lustratives són aquelles que no han format part de l’ACP, però poden estar-hi relacionades.

Per tant, poden ser variables útils per descriure i interpretar la solució obtinguda. Aquest ús de les variables il·lustratives permet realitzar un contrast d’hipòtesi i interpretar els nivells de significació de la relació entre la variable il·lustrativa i cada una de les components.

El rebuig d’aquesta hipòtesi implica afirmar que les components (i, per tant, les variables que aquestes components resumeixen) estan relacionades de forma significativa amb la variable il·lustrativa. La relació amb les poques components fa innecessari establir relacions amb les moltes variables originals.

#Per aquest exercici tindrà sentit utilitzar les variables 'var_global' (valoració global) i 'ingr_pta' (ingressos en pessetes), ja que ambdós podrien 

ilus<-data.frame(global_val=dades$val_glob,acp$x[,1:4])
ilus.num<-data.frame(global_val=dades$val_glob,ingr_pta=dades$ingr_pta,acp$x[,1:4])
plot(ilus.num[,-1])

plot(ilus.num[,-2])

La valoració segons

library(Hmisc)
## Loading required package: survival
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
rcorr(as.matrix(ilus.num[,-2]),type='pearson')
##            global_val   PC1  PC2  PC3   PC4
## global_val       1.00 -0.69 0.01 0.06 -0.02
## PC1             -0.69  1.00 0.00 0.00  0.00
## PC2              0.01  0.00 1.00 0.00  0.00
## PC3              0.06  0.00 0.00 1.00  0.00
## PC4             -0.02  0.00 0.00 0.00  1.00
## 
## n= 1271 
## 
## 
## P
##            global_val PC1    PC2    PC3    PC4   
## global_val            0.0000 0.8175 0.0229 0.3829
## PC1        0.0000            1.0000 1.0000 1.0000
## PC2        0.8175     1.0000        1.0000 1.0000
## PC3        0.0229     1.0000 1.0000        1.0000
## PC4        0.3829     1.0000 1.0000 1.0000

Segons podem observar la primera component (PC1 = entorn) és significativa al 95% respecte a la valoració global, la 4a component (PC3 = oferta) ho és al 90%. Les altres components no són significatives.

Realitzem un gràfic bivariant per on representar-hi les puntuacions mitjanes de cada localitat EL BLOC A CONTINUACIÓ NO HE ACONSEGUIT TREBALLAR-LO AMB ÈXIT. O bé mostra error per diferent longituds dels objectes, o per si no és vector, o error de sintaxi…

Per si tens temps generar una taula automàticament des de la imatge adjunta al word (tecnologia OCR) amb la definició de cada variable